﻿Imports Microsoft.Office.Interop
Imports Extensibility

Imports System.Runtime.InteropServices
Imports Microsoft.Vbe.Interop
Imports Microsoft.Office.Core
'+++++++++++++++++++++++++++++++++++++++++++++++++++

Imports System.IO

Imports System.Text
Imports System.Drawing
Imports System.Windows.Forms
'+++++++++++++++++++++++++++++++++++++++++++++++++++
<ComVisible(True), Guid("3599862B-FF92-42DF-BB55-DBD37CC13565"), ProgId("VBE2021.Connect")>
Public Class Connect
    Implements Extensibility.IDTExtensibility2 '导入接口
    '++++++++++++++++++++++++++++++++++
    Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As HookType, ByVal lpfn As HOOKPROC, ByVal hmod As Integer, ByVal dwThreadId As Integer) As Integer
    Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Integer) As Integer
    Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Integer, ByVal ncode As Integer, ByVal wParam As Integer, ByVal lParam As Integer) As Integer
    Declare Function GetCurrentThreadId Lib "kernel32" Alias "GetCurrentThreadId" () As Integer
    Public Delegate Function HOOKPROC(ByVal nCode As Integer, ByVal wParam As Integer, ByVal lParam As Integer) As Integer
    Public Declare Function FindWindowEx Lib "user32.dll" Alias "FindWindowExA" (ByVal hwndParent As Integer,
ByVal hwndChildAfter As Integer, ByVal lpszClass As String, ByVal lpszWindow As String) As Integer

    Public hnexthookproc As Integer

    Public Enum HookType
        WH_KEYBOARD = 2
    End Enum

    Private Declare Auto Function FindWindow Lib "user32" (ByVal lpClassName As String, ByVal lpWindowName As String) As Integer
    '++++++++++++++++++++++++++++++++++++++++
    '//
    Private Sub OnConnection(Application As Object, ConnectMode As Extensibility.ext_ConnectMode,
       AddInInst As Object, ByRef custom As System.Array) Implements Extensibility.IDTExtensibility2.OnConnection
        Try

            _VBE = DirectCast(Application, VBE)
            _AddIn = DirectCast(AddInInst, AddIn)
            Select Case ConnectMode
                Case Extensibility.ext_ConnectMode.ext_cm_Startup
                    'InitializeAddIn()
                Case Extensibility.ext_ConnectMode.ext_cm_AfterStartup
                    'InitializeAddIn()
                    'Dim hd As Integer = _VBE.ActiveCodePane.Window.HWnd
            End Select

        Catch ex As Exception
            MsgBox(ex.ToString())
        End Try
    End Sub

    Private Sub OnDisconnection(RemoveMode As Extensibility.ext_DisconnectMode,
       ByRef custom As System.Array) Implements IDTExtensibility2.OnDisconnection
        Try
            Select Case RemoveMode
                Case ext_DisconnectMode.ext_dm_HostShutdown, ext_DisconnectMode.ext_dm_UserClosed
                    If Not (_myToolbar Is Nothing) Then
                        _myToolbar.Delete()
                    End If
            End Select
            'Call UnHook() '解除钩子
        Catch e As System.Exception
            MsgBox(e.ToString)
        End Try
    End Sub

    Private Sub OnStartupComplete(ByRef custom As System.Array) _
       Implements IDTExtensibility2.OnStartupComplete
        InitializeAddIn()

        '+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
        'HOOK
        '+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
        Call SetHook()

    End Sub

    Private Sub OnAddInsUpdate(ByRef custom As System.Array) Implements IDTExtensibility2.OnAddInsUpdate

    End Sub

    Private Sub OnBeginShutdown(ByRef custom As System.Array) Implements IDTExtensibility2.OnBeginShutdown

    End Sub

    Sub InitializeAddIn()
        '//初始化工具条主程序
        Try

            ' ------------------------------------------------------------------------------------
            ' 新增工具条
            ' ------------------------------------------------------------------------------------
            _myToolbar = _VBE.CommandBars.Add("My toolbar", MsoBarPosition.msoBarTop, System.Type.Missing, True)
            '//获取代码库路径
            Dim PP As String = ReadOneString("配置信息", "代码库路径", Path.GetDirectoryName(System.Reflection.Assembly.GetExecutingAssembly().Location) & "\配置.ini")
            '如果配置信息不存在代码库路径或者代码库路径不存在，则直接设定为安装路径下的Code文件夹
            If PP = "" Or IO.File.Exists(PP) = False Then
                CodePath = Path.GetDirectoryName(System.Reflection.Assembly.GetExecutingAssembly().Location) & "\Code\"
            End If


            '//工具条增加菜单
            '/遍历文件夹生成分菜单
            Dim dir As New IO.DirectoryInfo(CodePath)

            ' 向工具条增加一个按钮
            _myToolBarButton1 = MakeANewButton(_myToolbar, "智能缩进-模块级", 346, AddressOf _myToolBarButton_Click) '添加工具栏按钮并帮定事件
            '添加第二个按钮
            _myToolBarButton2 = MakeANewButton(_myToolbar, "删除空行", 699, AddressOf _myToolBarButton_Click) '添加工具栏按钮并帮定事件
            '添加第二个按钮
            _myToolBarButton3 = MakeANewButton(_myToolbar, "注释", 120, AddressOf _myToolBarButton_Click) '添加工具栏按钮并帮定事件

            '/第一层文件夹
            For Each MyFol In dir.GetDirectories

                ToolbatMenu = _myToolbar.Controls.Add(MsoControlType.msoControlPopup, System.Type.Missing, System.Type.Missing, _myToolbar.Controls.Count + 1, True)
                ToolbatMenu.Caption = MyFol.Name
                ToolbatMenu.BeginGroup = True
                Dim dir2 As New IO.DirectoryInfo(MyFol.FullName)
                '/第二层文件夹
                For Each MyFol2 In dir2.GetDirectories

                    ToolbatMenu2 = ToolbatMenu.Controls.Add(MsoControlType.msoControlPopup, System.Type.Missing, System.Type.Missing, ToolbatMenu.Controls.Count + 1, True)
                    ToolbatMenu2.Caption = MyFol2.Name
                    ToolbatMenu2.BeginGroup = True
                    '/第二层文件
                    For Each MyFile In IO.Directory.GetFiles(MyFol2.FullName)
                        Dim FileInfo As New IO.FileInfo(MyFile)
                        If FileInfo.Extension = ".txt" Then
                            ReDim Preserve Btnarr(0 To BtnCount)
                            Btnarr(BtnCount) = MakeANewMenuButton(ToolbatMenu2, Replace(FileInfo.Name, ".txt", ""), 339, AddressOf _myToolBarButton_Click) '添加工具栏按钮并帮定事件
                            Btnarr(BtnCount).BeginGroup = True
                            BtnCount = BtnCount + 1

                        End If
                    Next
                Next
                '/第一层文件
                For Each MyFile In IO.Directory.GetFiles(MyFol.FullName)
                    Dim FileInfo As New IO.FileInfo(MyFile)
                    If FileInfo.Extension = ".txt" Then
                        ReDim Preserve Btnarr(0 To BtnCount)
                        Btnarr(BtnCount) = MakeANewMenuButton(ToolbatMenu, Replace(FileInfo.Name, ".txt", ""), 339, AddressOf _myToolBarButton_Click) '添加工具栏按钮并帮定事件
                        Btnarr(BtnCount).BeginGroup = True
                        BtnCount = BtnCount + 1

                    End If
                Next
            Next

            '/主菜单
            ToolbatMenu = _myToolbar.Controls.Add(MsoControlType.msoControlPopup, System.Type.Missing, System.Type.Missing, 1, True)
            ToolbatMenu.Caption = "VBE2021"
            ReDim Preserve Btnarr(0 To BtnCount + 3)
            Btnarr(BtnCount) = MakeANewMenuButton(ToolbatMenu, "代码库", 46, AddressOf _myToolBarButton_Click) '添加工具栏按钮并帮定事件
            Btnarr(BtnCount).BeginGroup = True
            Btnarr(BtnCount + 1) = MakeANewMenuButton(ToolbatMenu, "关于作者", 607, AddressOf _myToolBarButton_Click) '添加工具栏按钮并帮定事件
            Btnarr(BtnCount + 1).BeginGroup = True
            Btnarr(BtnCount + 2) = MakeANewMenuButton(ToolbatMenu, "软件更新", 37, AddressOf _myToolBarButton_Click) '添加工具栏按钮并帮定事件
            Btnarr(BtnCount + 2).BeginGroup = True
            Btnarr(BtnCount + 3) = MakeANewMenuButton(ToolbatMenu, "软件配置", 642, AddressOf _myToolBarButton_Click) '添加工具栏按钮并帮定事件
            Btnarr(BtnCount + 3).BeginGroup = True


            '+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
            '右键菜单
            '+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
            '_VBE.CommandBars("Code Window").Reset() '重置右键菜单
            'RightMenuBtn(0) = MakeRightMenu("全部注释", 462, AddressOf _myToolBarButton_Click)
            'RightMenuBtn(1) = MakeRightMenu("解除注释", 464, AddressOf _myToolBarButton_Click)
            RightMenuBtn(0) = MakeRightMenu("删除空行", 699, AddressOf _myToolBarButton_Click)
            ToolbatMenu3 = _VBE.CommandBars("Code Window").Controls.Add(MsoControlType.msoControlPopup, System.Type.Missing, System.Type.Missing, _VBE.CommandBars("Code Window").Controls.Count + 1, True)
            ToolbatMenu3.Caption = "智能缩进"
            ToolbatMenu3.BeginGroup = True
            RightMenuBtn(1) = MakeRightMenu2("模块缩进", 346, AddressOf _myToolBarButton_Click)
            RightMenuBtn(2) = MakeRightMenu2("过程缩进", 346, AddressOf _myToolBarButton_Click)
            RightMenuBtn(3) = MakeRightMenu2("工程全部缩进", 346, AddressOf _myToolBarButton_Click)
            ' 工具条可见
            _myToolbar.Visible = True
            '//读取代码库,写入数组和字典
            Dim Codewb As Excel.Workbook = GetObject(KeyWordPath)
            CodeArr = Codewb.Worksheets("CodeList").range("a2:c" & Codewb.Worksheets("CodeList").cells(1000000, 1).end(3).row).value
            Codewb.Close(0)
            For i = 1 To UBound(CodeArr)
                DCodeArr.Add(CodeArr(i, 2), CodeArr(i, 3))
            Next
            'Dim a As Object = CodeArr

            'Try

            '建立EXCEL连接，读入数据，支持 Microsoft Excel 2010
            'Dim strConn As String = "Provider= Microsoft.Ace.OleDb.12.0;Data Source='" & KeyWordPath & "';Extended Properties=Excel 12.0;"
            '建立EXCEL连接，读入数据，支持 Microsoft Excel 2003
            'Dim strConn As String = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source='" & fileName & "';Extended Properties=Excel 8.0;"
            '  Dim da As New OleDb.OleDbDataAdapter("SELECT * FROM [CodeList$]", strConn)
            '  Dim ds As DataSet = New DataSet
            ' da.Fill(ds)
            'ReDim CodeArr(0 To ds.Tables(0).Rows.Count - 1, 0 To ds.Tables(0).Rows(1).ItemArray.Length - 1)
            'dataset数据写入数组
            ' For i = 0 To ds.Tables(0).Rows.Count - 1
            '  For j = 0 To ds.Tables(0).Rows(i).ItemArray.Length - 1
            '     CodeArr(i, j) = ds.Tables(0).Rows(i).ItemArray(j).ToString
            '   Next
            ' Next
            ' Dim aaaaa As Object = CodeArr
            'For i = 0 To UBound(CodeArr) - 1
            '   DCodeArr.Add(CodeArr(i, 1), CodeArr(i, 2))
            ' Next
            ' Catch
            '  MsgBox(Err.Description)
            'End Try


        Catch  
            MsgBox(Err.Description)
        End Try
    End Sub



    Private Sub _myToolBarButton_Click(Ctrl As Microsoft.Office.Core.CommandBarButton, ByRef CancelDefault As Boolean)
        Try
            '//按钮点击调用的公用点击事件
            Select Case Ctrl.Caption
                Case "代码库"
                    Dim CodeForm As New CodeFrom
                    CodeForm.Show()
                Case "关于作者"
                    '/获取一系列句柄

                    Dim Auther As New authors
                    Auther.Show()
                Case "智能缩进-模块级"
                    Call IndentModule()
                Case "模块缩进"
                    Call IndentModule()
                Case "过程缩进"
                    Call IndentProcedure()
                Case "工程全部缩进"
                    Call IndentProject()
                Case "删除空行"
                    Call DelBlankRow()
                Case "注释"
                    Call annotation()
                Case "软件更新"
                    Dim updatef As New UpdateForm
                    updatef.Show()
                Case "软件配置"
                    Dim ini As New IniForm
                    ini.Show()
                Case Else
                    '/插入代码核心操作

                    Dim oCP As CodePane = _VBE.ActiveCodePane

                    If oCP Is Nothing Then
                        MsgBox("找不到模块！", vbOKOnly, "温馨提示")
                        Exit Sub
                    End If
                    Try

                        Dim SelInfo As SelLineColInfo '申明自定数据类型
                        SelInfo = VBGetSelection() '获取光标选中代码的位置信息
                        If GetParent(Ctrl) = "" Then
                            '/插入到开头
                            ' _VBE.ActiveCodePane.CodeModule.AddFromString(ReadTextFile(Path.GetDirectoryName(APPpath) & "\Code\" & Ctrl.Parent.Parent.caption & "\" & Ctrl.Caption & ".txt"))
                            '/插入到当前光标所在位置
                            _VBE.ActiveCodePane.CodeModule.InsertLines(SelInfo.SLine, ReadTextFile(CodePath & Ctrl.Parent.Parent.caption & "\" & Ctrl.Caption & ".txt"))
                        Else
                            ' _VBE.ActiveCodePane.CodeModule.AddFromString(ReadTextFile(Path.GetDirectoryName(APPpath) & "\Code\" & GetParent(Ctrl) & "\" & Ctrl.Parent.Parent.caption & "\" & Ctrl.Caption & ".txt"))
                            _VBE.ActiveCodePane.CodeModule.InsertLines(SelInfo.SLine, ReadTextFile(CodePath & GetParent(Ctrl) & "\" & Ctrl.Parent.Parent.caption & "\" & Ctrl.Caption & ".txt"))
                        End If
                        '.InsertLines()
                    Catch
                    End Try
            End Select
        Catch
            MsgBox(Err.Description)
        End Try
    End Sub


    '↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓
    Public Sub UnHook()  '解Hook
        If hnexthookproc <> 0 Then
            UnhookWindowsHookEx(hnexthookproc)
            hnexthookproc = 0
        End If
    End Sub
    Public KeyboardHookProcedure As HOOKPROC
    Public Sub SetHook() '设置Hook
        If hnexthookproc <> 0 Then
            Exit Sub
        End If
        Dim imme As Integer
        Dim VBIDE As Integer = FindWindow("wndclass_desked_gsk", vbNullString)
        If VBIDE Then
            imme = FindWindowEx(VBIDE, 0, "MDIClient", vbNullString)
            imme = FindWindowEx(imme, 0, "VbaWindow", vbNullString)
        End If
        KeyboardHookProcedure = New HOOKPROC(AddressOf MyKeyboardProc)
        hnexthookproc = SetWindowsHookEx(HookType.WH_KEYBOARD, KeyboardHookProcedure, 0, GetCurrentThreadId())
        'GCHandle.Alloc(hnexthookproc) '防止被垃圾回收
    End Sub




    Public Function MyKeyboardProc(ByVal nCode As Integer, ByVal wParam As Integer, ByVal lParam As Integer) As Integer

        ' GCHandle.Alloc(MyKeyboardProc) '防止被垃圾回收
        MyKeyboardProc = 0
        Dim p As PointAPI
        If nCode < 0 Then
            MyKeyboardProc = CallNextHookEx(hnexthookproc, nCode, wParam, lParam)
            Exit Function
        End If
        '/获取一系列句柄
        Dim VBIDE As Integer = FindWindow("wndclass_desked_gsk", vbNullString)

        If VBIDE Then
            ActiveCodePane_Handle = FindWindowEx(VBIDE, 0, "MDIClient", vbNullString)
            ActiveCodePane_Handle = FindWindowEx(ActiveCodePane_Handle, 0, "VbaWindow", vbNullString)
            '获取VBA编辑窗口的句柄。wndclass_desked_gsk→MDIClient→VbaWindow
        End If
        ActiveHandle = GetFocus() '光标所在窗口的句柄

        If ActiveHandle = ActiveCodePane_Handle Then '当活动窗口是VBAWindow的时候，才触发
            If KeyTip_TN = True Then '控制智能提示的开关

                If wParam = PM_KEY_SPACE And lParam < 0 Then
                    Dim SelInfo As SelLineColInfo = VBGetSelection() '获取光标所在位置
                    '当按键是空格键并且是按键弹起的时候，才触发。如果不限制按键弹起触发，则会触发多次
                    '' Dim SpaceStr As String = Replace(Right(_VBE.ActiveCodePane.CodeModule.Lines(SelInfo.SLine, 1), 3), " ", "") '获取当前行数据
                    ''If SpaceStr <> "" Then
                    MyKeyboardProc = 1
                    If CodeList_Handle = 0 Then
                        ' Dim f As New CodeList
                        f.Show() '显示之后立马隐藏
                        f.Hide()
                        SetFocus(ActiveHandle)
                    End If
                    '//更新窗体数据

                    Dim KeyStr As String = Trim(_VBE.ActiveCodePane.CodeModule.Lines(SelInfo.SLine, 1)) '获取当前行数据
                        Dim arr As Object = Split(KeyStr, " ") '利用空格写入数组
                        KeyStr = UCase(arr(UBound(arr))) '转换为大写，方便匹对
                        '/刷新Listbox1的列表
                        f.ListBox1.Items.Clear()
                        Dim brr() As Object = Nothing  '动态数组，存储临时匹配结果
                        Dim xx As Int16 = 0
                        For X = 1 To UBound(CodeArr)
                        If UCase(CodeArr(X, 2)) Like "*" & KeyStr & "*" Then
                            ReDim Preserve brr(0 To xx)
                            brr(xx) = CodeArr(X, 2)
                            xx = xx + 1
                        End If
                    Next
                        If xx > 0 Then '匹配到结果的时候才进行写入，匹配不到不写
                            f.ListBox1.Items.AddRange(brr)
                            '//获取光标屏幕坐标，移动窗口
                            GetCaretPos(p) '取光标标所在位置坐标
                            ClientToScreen(ActiveHandle, p) '转化为屏幕坐标
                        MoveWindow(CodeList_Handle, p.x, p.y + 30, 600, 340, True) '将代码窗体显示到光标下方
                        SetWindowPos(CodeList_Handle, 0, 0, 0, 0, 0, SWP_NOACTIVATE Or SWP_SHOWWINDOW Or SWP_NOSIZE Or SWP_NOMOVE)
                            'SetForegroundWindow(CodeList_Handle)
                            f.ListBox1.SelectedIndex = 0
                            f.RichTextBox1.Text = DCodeArr.Item(f.ListBox1.SelectedItem.ToString)
                            'SetFocus(f.ListBox1.Handle) '如果设置了焦点，则可以直接按上下按键选择项目
                            ESC_TN = False
                            'SetWindowLong(f.Handle, GWL_EXSTYLE, WS_DISABLED)

                        End If
                        'ShowWindow(CodeList_Handle, SW_SHOWNOACTIVATE)
                    ElseIf wParam = 40 Then '留待以后解决，按↓，实现listbox向下运行
                        'f.ListBox1.SelectedIndex = f.ListBox1.SelectedIndex + 1
                    Else
                        'If wParam = PM_KEY_BackSpace Then '只要按下其他按键，就直接隐藏窗体
                        If IsWindow(CodeList_Handle) And ESC_TN = False Then
                            SetWindowPos(CodeList_Handle, 0, 0, 0, 0, 0, SWP_HIDEWINDOW)
                            SetFocus(ActiveHandle)
                            ESC_TN = True
                        End If
                        '' End If '空格太多的时候，不触发
                    End If
            End If
            '捕捉快捷键,控制HOOK开关
            If nCode = 3 And wParam = 191 And lParam < 0 Then 'lParam = 1077215233
                annotation()
            End If

            'If Val(wParam.ToString) = 40 And lParam < 0 Then
            'If IsWindowVisible(CodeList_Handle) = 1 Then

            'f.ListBox1.SelectedIndex = f.ListBox1.SelectedIndex + 1
            'End If

            'End If
        End If
    End Function
    '+++++++++++++++++++++++++++++++++++++++++

End Class